home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
colorset.zip
/
COLORSET.PRE
< prev
next >
Wrap
Text File
|
1993-01-04
|
21KB
|
847 lines
* COLORSET.PRE
*
* GENERIC PROCEDURE allows user to interactively change colors.
*
* Michael K. Bozovich
* 12-20-1989 <Panama Invasion Day>
*
* This procedure requires linking with IDL.LIB and EXTEND.LIB in
* addition to the standard CLIPPER.LIB.
*
* Global Color Variables:
*
* c_scr_color - 'Normal Text' - used by most everything...
* c_err_color - 'Error Messages'
* c_msg_color - 'Status Messages'
* c_int_color - 'Screen Titles / High Intensity'
* c_inv_color - 'Input Fields / Inverse Video / GETs'
* c_hlp_color - 'Help Screen Colors'
*
* Programmer imposed limitations:
*
* 1. Foreground and background colors may NOT match.
* This combination is totally disallowed and may not
* even be chosen by accident.
*
* 2. The screen title color must have the same background
* as the normal text color.
*
* 3. The "enhanced" color for normal text is ALWAYS the
* "standard" color for input fields and vice versa.
*
#include colorset.h
*
* Save current DOS screen attribute for clearing screen upon exit.
*
save_attr = GET_ATTR()
*
* Define screen colors based on graphics card detected.
*
IF ! FILE("colors.mem")
IF VID_TYPE() > 0
c_scr_color = "15/1,1/3" && Overall Screen colors
c_err_color = "15/4" && Error Messages
c_msg_color = "15/2" && Status Messages
c_int_color = "14/1" && High Intensity
c_inv_color = "1/3,3/1" && Inverse Video
c_hlp_color = "10/0" && Help Screen(s)
ELSE
c_scr_color = "7/0,0/7" && Complimentary MONO colors...
c_err_color = "0/15"
c_msg_color = "0/7"
c_int_color = "15/0"
c_inv_color = "0/7,7/0"
c_hlp_color = "0/7"
ENDIF
SAVE TO colors.mem ALL LIKE c_*
ENDIF
RESTORE FROM colors.mem ADDITIVE
SET COLOR TO (c_scr_color)
SET CURSOR OFF
CLEAR SCREEN
*
* This 'hidden' color variable is only used only for hiding the simulated
* wait state READ in COLORSEL below.
*
* It can be derived from the current screen colors. Here is the algorithm...
*
hidden = LSTR(BACK(GET_ATTR()))
hidden = hidden + "/" + hidden + "," + hidden + "/" + hidden
*
* Define these variables to be 'global'. They are used by COLORSEL and
* must be returned successfully in order to build the modified color strings.
*
STORE 0 TO _attr_, fore, back
*
* Draw a sample screen 'Title'
*
DO Title
*
* Draw the color sample box.
*
@ SAMP_ULR, SAMP_ULC TO SAMP_LRR, SAMP_LRC DOUBLE
_str_row_ = (SAMP_LRR - SAMP_ULR) / 2 + SAMP_ULR
*
* This next routine draws the rectangle of all possible colors that the user
* may choose from and saves the screen to a mem file.
*
* The outer (i) FOR loop cycles through the possible
* BACKGROUND colors.
*
* The inner (j) FOR loop cycles through the possible
* FOREGROUND colors.
*
* The supplemental counter (k) is used for cursor
* positioning so that there is even spacing between the attribute numbers.
*
* THIS IS UNACCEPTABLY SLOW, EVEN ON A 12-Mhz AT !!!
*
* Try the following:
*
* 1. Use Clipper SET COLOR TO instead of APRINT(). - Just as slow.
* 2. Draw the stupid thing in "hidden color" and use - Just as slow.
* the SET_ATTR() function to splash on the color.
* 3. Save/Restore screen from a memvar. - Very acceptable.
*
* The solution is, of course, to only draw the fucker if necessary, save it
* to a memvar file, and pop it on the screen every other time.
*
IF ! FILE("attrib.mem")
FOR i = 0 TO 7
k = 0
FOR j = 0 TO 15
@ i + BACK_ROW_MIN, j + (FORE_COL_MIN - 2) + k SAY ;
APRINT(" " + STRZERO(j + i * 16, 3) + " ", j + i * 16)
k = k + 3
NEXT j
NEXT i
attr_screen = SAVESCREEN(BACK_ROW_MIN, FORE_COL_MIN - 2, ;
BACK_ROW_MAX, FORE_COL_MAX + 2)
SAVE TO attrib.mem ALL LIKE attr_screen*
ENDIF
*
* Restore from the screen memfile and pop up the screen.
*
RESTORE FROM attrib.mem ADDITIVE
RESTSCREEN(BACK_ROW_MIN, FORE_COL_MIN - 2, ;
BACK_ROW_MAX, FORE_COL_MAX + 2, attr_screen)
*
* Set up for ACHOICE()...
*
PRIVATE options[7]
options[1] = "1 - Normal Screen Text"
options[2] = "2 - Screen Titles"
options[3] = "3 - Input Fields"
options[4] = "4 - Status Messages"
options[5] = "5 - Error Messages"
options[6] = "6 - Help Screens"
options[7] = "7 - Save Selections"
@ MENU_ULR, MENU_ULC TO MENU_LRR, MENU_LRC DOUBLE
choice = 1
DO WHILE .t.
* SET KLUDGE ON
KEYPRESS(HOME) && Keep the silly thing 'synchronized' ......
* SET KLUDGE OFF
ACHOICE(MENU_ULR + 1, MENU_ULC + 2, MENU_LRR - 1, MENU_LRC - 2, ;
options, .t., "showstat", choice)
IF LASTKEY() == ESC
EXIT
ENDIF
ENDDO
CLS(save_attr)
SET CURSOR ON
******************************************************************************
******************************************************************************
******************************************************************************
FUNCTION SHOWSTAT
*
* This function is called from the ACHOICE() function with each keypress.
*
* It's main purpose is to keep the sample window screen region updated
* with the color for the currently highlited choice.
*
* If the <Enter> key is pressed, the actual COLORSEL routine is called
* and the user can play...
*
* If the <Esc> key is pressed, the value indicating 'abort' is returned
* and ACHOICE() exits.
*
* Note the kludge allowing wrap around within ACHOICE()...
*
PARAMETERS mode, index, win_pos
*
* This little kludge stores the current attribute of the menu hilite so we
* can KEEP it hilited while in the keystroke exception, even though ACHOICE
* normally does not.
*
SET COLOR TO (c_inv_color)
item_atr = FOREGROUND() + BACKGROUND() * 16
SET COLOR TO (c_scr_color)
* SET FUN ON
*
* Calculate a suitable 'dim' attribute so we can dim the menu while in
* COLORSEL...
*
dim_attr = IF(FOREGROUND() == 7, 8, 7) + BACKGROUND() * 16
* SET FUN OFF
*
* Update the sample window...
*
IF index == 1 && Normal
SET COLOR TO (c_scr_color)
_str_ = "NORMAL TEXT"
ELSEIF index == 2 && Title
SET COLOR TO (c_int_color)
_str_ = "SCREEN TITLE"
ELSEIF index == 3 && Inverse
SET COLOR TO (c_inv_color)
_str_ = "INPUT FIELD"
ELSEIF index == 4 && Messages
SET COLOR TO (c_msg_color)
_str_ = "STATUS MESSAGE"
ELSEIF index == 5 && Error Messages
SET COLOR TO (c_err_color)
_str_ = "ERROR MESSAGE"
ELSEIF index == 6 && Help Screens
SET COLOR TO (c_hlp_color)
_str_ = "HELP SCREEN"
ELSEIF index == 7 && Save (Normal)
SET COLOR TO (c_scr_color)
_str_ = "<UNDEFINED>"
ENDIF
_str_col_ = (SAMP_LRC - SAMP_ULC - LEN(_str_)) / 2 + SAMP_ULC
@ _str_row_, SAMP_ULC + 1 SAY SPACE(SAMP_LRC - SAMP_ULC - 1)
*
* With the proper color turned on, say the nifty little message in the
* sample window so we can tell what it is from GET_ATTR() below...
*
@ _str_row_, _str_col_ SAY _str_
*
* Some of the sample box is left with the "normal text" color value.
* Fill in the rest of it with this IDL command. How handy!
*
SET_ATTR(GET_ATTR(_str_row_,_str_col_),SAMP_ULR,SAMP_ULC,SAMP_LRR,SAMP_LRC)
*
* Turn 'normal' color back on...
*
SET COLOR TO (c_scr_color)
IF (mode == AC_TOP .AND. LASTKEY() == UP) .OR. ; && Allows 'wrap'
(mode == AC_END .AND. LASTKEY() == DOWN)
* SET KLUDGE ON
choice = IF(mode == AC_TOP, 7, 1)
RETURN AC_SELECT
* SET KLUDGE OFF
ELSEIF mode == AC_KEY
*
* A key was pressed, we need to determine if it was one of our
* two 'special' keys.
*
IF LASTKEY() == ENTER
*
* Dim the pick list region to indicate that it is not active.
* Also 're-highlite' the selected record because ACHOICE() clears
* the highlite when the record is selected.
*
SET_ATTR(dim_attr, MENU_ULR, MENU_ULC, MENU_LRR, MENU_LRC)
SET_ATTR(item_atr, MENU_ULR + index, MENU_ULC + 2, ;
MENU_ULR + index, MENU_LRC - 2)
*
* If we are not 'saving',
* Do the color selection routine and let the user play...
*
IF index # 7
DO COLORSEL
ENDIF
*
* For each case below, a new global variable must be constructed.
*
* Depending on the variable updated, portion(s) of the screen may
* need to be 'refreshed'...
*
* If it was the overall 'normal text' color that was altered, a
* little extra work needs to be done. Likewise with the 'input field'
* colors. (Inverse video) Otherwise, the construction is straightforward
* as demonstrated below...
*
IF index == 1 && Normal
*
* Since the normal and inverse strings are mutually interdependent,
* if one was altered, so must the other be. i.e. ............
*
c_scr_color = fore + "/" + back + "," + STANDARD(c_inv_color)
c_inv_color = STANDARD(c_inv_color) + "," + fore + "/" + back
*
* Since the 'title screen' colors are also used for 'high intensity'
* in others places through the system, I am restricting the background
* to be the same as the 'normal text' background. The user just
* changed the 'normal text', so the 'title screen' variable must
* also be....
*
c_int_color = SUBSTR(c_int_color, 1, AT("/", c_int_color)) + back
*
* The 'hidden' color variable is only used only for hiding the simulated
* wait state READ below.
*
* It needs to be re-generated from the 'normal text' variable
* each time it is changed. Here is the algorithm...
*
hidden = back + "/" + back + "," + back + "/" + back
*
* IDL to the rescue!
* To avoid redrawing the screen to reflect the new overall
* text colors, just 'splash it on'..... :)
*
SET_ATTR(_attr_, 0, 0, 24, 79)
*
* Since we just wiped out the color selection rectangle, pop it back...
*
RESTSCREEN(BACK_ROW_MIN, FORE_COL_MIN - 2, ;
BACK_ROW_MAX, FORE_COL_MAX + 2, attr_screen)
*
* ...re-draw the title...
*
DO Title
*
* ...'re-dim' the menu...
*
SET COLOR TO (c_scr_color)
dim_attr = IF(FOREGROUND() == 7, 8, 7) + BACKGROUND() * 16
SET_ATTR(dim_attr, MENU_ULR, MENU_ULC, MENU_LRR, MENU_LRC)
*
* ...and 're-hilite' the current menu item. <Whew!>
*
SET COLOR TO (c_inv_color)
item_atr = FOREGROUND() + BACKGROUND() * 16
SET_ATTR(item_atr, MENU_ULR + index, MENU_ULC + 2, ;
MENU_ULR + index, MENU_LRC - 2)
*
* Better tell Clipper about the global color change now...
*
SET COLOR TO (c_scr_color)
ELSEIF index == 2 && Title
c_int_color = fore + "/" + back
DO Title
ELSEIF index == 3 && Inverse
*
* Since the normal and inverse strings are mutually interdependent,
* if one was altered, so must the other be. i.e. ............
*
c_inv_color = fore + "/" + back + "," + STANDARD(c_scr_color)
c_scr_color = STANDARD(c_scr_color) + "," + fore + "/" + back
*
* We changed the 'inverse' color, so we have to redraw the
* current item on the menu...
*
SET COLOR TO (c_inv_color)
item_atr = FOREGROUND() + BACKGROUND() * 16
SET COLOR TO (c_scr_color)
SET_ATTR(item_atr, MENU_ULR + index, MENU_ULC + 2, ;
MENU_ULR + index, MENU_LRC - 2)
ELSEIF index == 4 && Messages
c_msg_color = fore + "/" + back
ELSEIF index == 5 && Error Messages
c_err_color = fore + "/" + back
ELSEIF index == 6 && Help Screens
c_hlp_color = fore + "/" + back
ELSEIF index == 7 && Save
SAVE TO colors.mem ALL LIKE c_*
ENDIF
*
* Wipe off the silly looking arrows... :-)
*
@ FORE_ROW , 0
@ BACK_ROW_MAX + 1, 0
FOR i = BACK_ROW_MIN TO BACK_ROW_MAX
@ i, BACK_COL SAY SPACE(1)
@ i, FORE_COL_MIN - 4 SAY SPACE(1)
NEXT i
*
* 'Undim' the pick list region.
*
SET_ATTR(GET_ATTR(), MENU_ULR, MENU_ULC, MENU_LRR, MENU_LRC)
ELSEIF LASTKEY() == ESC
*
* Let ACHOICE() know we are done with it.
*
RETURN AC_ABORT
ENDIF
ENDIF
*
* Return value indicating 'continue'. This is returned if no keystroke
* exception interesting to us ocurred OR <Enter> was pressed.
*
RETURN AC_CONTINUE
******************************************************************************
******************************************************************************
******************************************************************************
PROCEDURE COLORSEL
*
* Determine the ~CURRENT~ IDL attribute value of the color set chosen.
*
* This value is used to calculate foreground and background values for
* Clipper color strings AND to calculate row & column positions for the
* pointers. It must be available to the NAVIGATE PROCEDURE...
*
_attr_ = GET_ATTR(_str_row_, _str_col_)
*
* Calculate the Clipper numerical values of the foreground and background
* colors based on the IDL attribute value. These variables must be
* available to the SET KEY "navigation" procedure below.
*
fore = FORE(_attr_)
back = BACK(_attr_)
*
* Calculate the current row and column positions for the arrow pointers
* based on the current attributes and print them there. These two
* variables must also be available to the SET KEY procedure below.
*
fore_col = (fore * 4) + FORE_COL_MIN
back_row = back + BACK_ROW_MIN
*
* The color is reset here to the ORIGINAL "normal text" colors in order
* to print usage messages and arrow pointers.
*
SET COLOR TO (c_scr_color)
@ 23, CENTER("Use the arrow keys to select a color combination", 80) SAY ;
"Use the arrow keys to select a color combination"
@ 24, CENTER("Press <Enter> to select, <Esc> to abort", 80) SAY ;
"Press <Enter> to select, <Esc> to abort"
@ FORE_ROW , fore_col SAY DOWN_ARROW
@ BACK_ROW_MAX + 1, fore_col SAY UP_ARROW
@ back_row , BACK_COL SAY LEFT_ARROW
@ back_row , FORE_COL_MIN - 4 SAY RIGHT_ARROW
*
* Activate the SET KEY procedure so that the user can move the nifty
* little arrows around and watch the pretty colors change right before
* their eyes.... :)
*
SET KEY RIGHT TO NAVIGATE
SET KEY LEFT TO NAVIGATE
SET KEY UP TO NAVIGATE
SET KEY DOWN TO NAVIGATE
* SET KLUDGE ON
*
* All the action takes place in this CONTRIVED WAIT STATE while the SET KEY
* procedure is activated. See notes in the procedure below.
*
* If Nantucket would allow INKEY() as a wait state... <sigh>
*
KEYPRESS(NULL)
INKEY()
dummy = " "
SET COLOR TO (hidden)
SET INTENSITY OFF
@ 0, 78 GET dummy VALID (LASTKEY() == ENTER .OR. LASTKEY() == ESC)
READ
SET INTENSITY ON
SET COLOR TO (c_scr_color)
@ 0, 78 SAY SPACE(1)
@ 23, 0 SAY SPACE(80)
@ 24, 0 SAY SPACE(80)
RELEASE dummy
* SET KLUDGE OFF
*
* OK, fun's over! Deactivate the hot keys so that the menu will work.
*
SET KEY RIGHT TO
SET KEY LEFT TO
SET KEY UP TO
SET KEY DOWN TO
IF LASTKEY() == ENTER
*
* Eureka!
*
* A new color was chosen while in the wait state. Let's re-read the
* attribute from the sample window.
*
_attr_ = GET_ATTR(SAMP_ULR, SAMP_ULC)
ENDIF
*
* User ~MAY~ have pressed ESC ...
* Just in case, re-draw the color of the sample window...
*
SET_ATTR(_attr_, SAMP_ULR, SAMP_ULC, SAMP_LRR, SAMP_LRC)
*
* Need need to re-calculate new foreground and background attribute values.
* This time, they need to be converted to STRINGS so Clipper can use them!
*
* Note: These will NOT have changed if the user pressed ESC!
*
fore = LSTR(FORE(_attr_))
back = LSTR(BACK(_attr_))
******************************************************************************
******************************************************************************
******************************************************************************
PROCEDURE NAVIGATE
*
* This SET KEY procedure moves the attribute pointers up/down/left/right
* to select foreground & background colors.
*
* 'Wrap around' is supported. As the arrow pointers move, the sample
* window background color is updated to reflect the current pointer
* positions.
*
PARAMETERS a, b, c
*
* Deactivate the hot-keys so this procedure may not call itself via hot-key.
*
SET KEY UP TO
SET KEY DOWN TO
SET KEY LEFT TO
SET KEY RIGHT TO
*
* User is attempting to change the background attribute of 'high-intensity'.
*
* TOUGH SHIT! Re-activate the hot-keys and return.
*
IF index == 2 .AND. (LASTKEY() == UP .OR. LASTKEY() == DOWN)
*# SNAP XREF OFF
SET KEY UP TO NAVIGATE
SET KEY DOWN TO NAVIGATE
SET KEY LEFT TO NAVIGATE
SET KEY RIGHT TO NAVIGATE
*# SNAP XREF ON
RETURN
ENDIF
*
* The color was changed to hide the READ. Change it back to normal.
*
SET COLOR TO (c_scr_color)
*
* Clear the screen positions where the arrows are CURRENTLY located.
*
IF LASTKEY() == UP .OR. LASTKEY() == DOWN
@ back_row, BACK_COL SAY SPACE(1)
@ back_row, FORE_COL_MIN - 4 SAY SPACE(1)
ELSE
@ FORE_ROW, fore_col SAY SPACE(1)
@ BACK_ROW_MAX + 1, fore_col SAY SPACE(1)
ENDIF
DO WHILE .t.
IF LASTKEY() == RIGHT
*
* Increment the pointer column by four. (move right)
*
fore_col = fore_col + 4
*
* If we have reached the end, go to the start. (wrap around)
*
IF fore_col > FORE_COL_MAX
fore_col = FORE_COL_MIN
ENDIF
ELSEIF LASTKEY() == LEFT
*
* Decrement the pointer column by four. (move left)
*
fore_col = fore_col - 4
*
* If we have reached the start, go to the end. (wrap around)
*
IF fore_col < FORE_COL_MIN
fore_col = FORE_COL_MAX
ENDIF
ELSEIF LASTKEY() == UP
*
* Decrement the row variable. (go up)
*
back_row = back_row - 1
*
* If we have reached the top, go to the bottom. (wrap around)
*
IF back_row < BACK_ROW_MIN
back_row = BACK_ROW_MAX
ENDIF
ELSE
*
* Increment the row variable. (go down)
*
back_row = back_row + 1
*
* If we have reached the bottom, go to the top. (wrap around)
*
IF back_row > BACK_ROW_MAX
back_row = BACK_ROW_MIN
ENDIF
ENDIF
*
* Re-calculate the attribute values based on the new pointer positions.
*
fore = (fore_col - FORE_COL_MIN) / 4
back = back_row - BACK_ROW_MIN
*
* If foreground # background, we're OK. Exit the loop.
* Otherwise, move to the next pointer position.
*
IF fore # back
EXIT
ENDIF
ENDDO
*
* Display the pointer arrows in their new positions.
*
IF LASTKEY() == UP .OR. LASTKEY() == DOWN
@ back_row, BACK_COL SAY LEFT_ARROW
@ back_row, FORE_COL_MIN - 4 SAY RIGHT_ARROW
ELSE
@ FORE_ROW , fore_col SAY DOWN_ARROW
@ BACK_ROW_MAX + 1, fore_col SAY UP_ARROW
ENDIF
*
* Update the sample window to reflect current pointer position color.
*
SET_ATTR(fore + back * 16, SAMP_ULR, SAMP_ULC, SAMP_LRR, SAMP_LRC)
*
* Re-Activate the hot keys just prior to returning.
*
*# SNAP XREF OFF
SET KEY UP TO NAVIGATE
SET KEY DOWN TO NAVIGATE
SET KEY LEFT TO NAVIGATE
SET KEY RIGHT TO NAVIGATE
*# SNAP XREF ON
*
* Change color back to hidden.
*
SET COLOR TO (hidden)
******************************************************************************
******************************************************************************
******************************************************************************
PROCEDURE Title
SET COLOR TO (c_int_color)
@ TITLE_ROW, TITLE_COL SAY TITLE
SET COLOR TO (c_scr_color)
* eof colorset.pre